; ORIGINAL: 3dt2.1/examples/hanoi.scm
; $Id: hanoi.scm,v 1.6 1997/04/30 20:24:12 jread Exp $
;----------------------------------------------------------------------
; purpose---
;    Towers of Hanoi using ACIS 3D Toolkit
;
; To run, load this file, then type (hanoi n) where n is the number of disks
;
;----------------------------------------------------------------------

(require 'oops 'oops.scm)

;; define some default sizes
(define post-radius 10)
(define disk-thickness 10)

;; render schene, or just delay so you can see what is happening
(define (hanoi:render-or-delay)
  (system:sleep 100)
)
(define (hanoi:set-display-mode mode)
  (cond ((eq? mode 'render) (set! hanoi:render-or-delay render))
        (else (set! hanoi:render-or-delay (lambda () (system:sleep 500))))
        ))

;;----------------------------------------------------------------------
;; Define the post class
(define-class post
  (class-vars (radius post-radius)
              (height 100)
              (color 3)
              )
  (instance-vars (location (position 0 0 0))
                 top
                 disks
                 body
                 ))

(define-method post (initialize-instance)
  (roll:mark-start)
  (set! body (solid:cylinder location
                             (position:offset location (gvector 0 0 height))
                             radius))
  (entity:set-color body color)
  (roll:mark-end)
  (set! top (position:copy location))
)

;; Add a disk to a post
(define-method post (add-disk d)
  (set! disks (cons d disks))
  (send d 'move-to top)
  (set! top (position:offset top (gvector 0 0 (send d 'get-thickness))))
  d
)

;; Remove a disk from a post
(define-method post (remove-disk)
  (let ((d (if (not (null? disks)) (car disks) #f)))
    (if d (begin
            (send d 'move-to (position:offset location
                                              (gvector 0 0 (+ height radius))))
            (set! disks (cdr disks))
            (set! top (position:offset
                       top
                       (gvector 0 0 (- (send d 'get-thickness)))))
            ))
    d))

;; Get a position above a post
(define-method post (position-over)
  (position:offset location (gvector 0 0 (+ height radius)))
)

;;----------------------------------------------------------------------
;; Define the disk class

(define-class disk (class-vars (thickness 10)
                               (hole-radius (* 1.1 post-radius))
                               )
  (instance-vars (location (position 0 0 0))
                 (radius 20)
                 (color 2)
                 body
                 ))

(define-method disk (initialize-instance)
  (roll:mark-start)
  (let ((pt1 location)
        (pt2 (position:offset location (gvector 0 0 thickness)))
        )
    (set! body (solid:subtract (solid:cylinder pt1 pt2 radius)
                               (solid:cylinder pt1 pt2 hole-radius)))
    (entity:set-color body color)
    (roll:mark-end)
    ))

;; Move a disk to a new location
(define-method disk (move-to pt)
  (entity:transform body (transform:translation (gvector:from-to location pt)))
  (set! location pt)
  pt
)

;; Get the thickness of a disk
(define-method disk (get-thickness) thickness)

;;----------------------------------------------------------------------
;; move the top disk from one post to another

(define (move-disk from to)
  (check-interrupt)                   ;; Allows one to quit with ^C
  (let ((d (send from 'remove-disk)))
    (if d (begin
            (hanoi:render-or-delay)
            (send d 'move-to (send to 'position-over))
            (hanoi:render-or-delay)
            (send to 'add-disk d)
            (hanoi:render-or-delay)
            ))
    d))

;;----------------------------------------------------------------------
;; This is the procedure that actually does it all
(define (transfer-disks from to via n)
  (if (= n 1)
      (move-disk from to)
      (transfer-disks from via to (1- n))
      (move-disk from to)
      (transfer-disks via to from (1- n))))

;;----------------------------------------------------------------------

(define (hanoi n)

;; Compute the size of the environment, and compute locations of posts
  (let* ((max-radius (* (+ 1 n) post-radius))
         (post-height (* (+ n 1) disk-thickness))
         (d (+ (* 2 max-radius) post-radius))
         (dy (sqrt (/ (* 3 (* d d)) 4)))
         (dx (/ d 2))
         (pt1 (position (- dx) 0 0))
         (pt2 (position dx 0 0))
         (pt3 (position 0 dy 0))
         )

    ;; create the posts
    (class-set! post 'height post-height)
    (let ((post1 (make-instance post (location pt1)))
          (post2 (make-instance post (location pt2)))
          (post3 (make-instance post (location pt3)))
          )

      ;; create the disks
      (do ((i 0 (+ i 1))
           (r max-radius (- r post-radius))
           )
          ((>= i n))
        (send post1 'add-disk (make-instance disk (radius r)))
        )

	  ;; Create a view if none exist
	  (if (null? (env:views)) (view:dl))

      ;; Make sure everything is visible
      (for-each (lambda (view)
                  (view:compute-extrema view)
                  (view:refresh (view:set-size (/ (view:width view) .65)
											 (/ (view:height view) .65) view)))
                (env:views))
      (hanoi:render-or-delay)

      ;; Now do it
      (transfer-disks post1 post2 post3 n)
      )))

